home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / ussbc23.zip / LIB16 / QRSSBC.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-14  |  2KB  |  104 lines
  1. unit Qrssbc;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Quickrep, ssBC;
  8.  
  9. type
  10.   TQRssBarcode = class(TQRCustomControl)
  11.   private
  12.     FBarcode : TssBarcode;
  13.  
  14.   protected
  15.     procedure Notification( AComponent: TComponent; Operation: TOperation); override;
  16.     procedure SetBarcode(Value : TssBarcode);
  17.     constructor Create(AOwner : TComponent); override;
  18.   public
  19.     procedure Print(PX,PY : integer); override;
  20.     procedure Paint; override;
  21.   published
  22.     property Barcode : TssBarcode read FBarcode write SetBarcode;
  23.   end;
  24.  
  25. procedure Register;
  26.  
  27. implementation
  28.  
  29. constructor TQrssBarcode.Create(AOwner : TComponent);
  30.  
  31. begin
  32.   inherited Create(AOwner);
  33.   Width:=200;
  34.   Height:=200;
  35. end;
  36.  
  37. procedure TQRssBarcode.SetBarcode(Value : TssBarcode);
  38.  
  39. begin
  40.   FBarcode := Value;
  41.   Invalidate;
  42. end;
  43.  
  44. procedure TQRssBarcode.Paint;
  45.  
  46. begin
  47.   if Assigned(FBarcode) then
  48.   begin
  49.     Width := FBarCode.Width;
  50.     Height := FBarcode.Height;
  51.     try
  52.       FBarcode.DataBits := FBarcode.CreateDatabits(Screen.PixelsPerInch);
  53.       FBarcode.AODataBits := FBarcode.CreateAODatabits(Screen.PixelsPerInch);
  54.     finally
  55.       FBarcode.DrawBarcode(Self.Canvas,0,0, Screen.PixelsPerInch);
  56.     end;
  57.   end
  58.   else
  59.   begin
  60.     if (csDesigning in ComponentState) then
  61.     with Canvas do
  62.     begin
  63.       Brush.Color := Self.Color;
  64.       Brush.Style := bsSolid;
  65.       FillRect(ClientRect);
  66.       Pen.Style := psDash;
  67.       Brush.Style := bsClear;
  68.       Rectangle(0, 0, Width, Height);
  69.       Pen.Style := psSolid;
  70.     end;
  71.   end;
  72. end;
  73.  
  74.  
  75. procedure TQRssBarcode.Print(PX,PY : integer);
  76.  
  77. begin
  78.   if Assigned(FBarcode) then
  79.   begin
  80.     try
  81.       FBarcode.DataBits := FBarcode.CreateDatabits(qrOrgRes);
  82.       FBarcode.AODataBits := FBarcode.CreateAODatabits(qrOrgRes);
  83.  
  84.     finally
  85.       FBarcode.DrawBarcode(QRPrinter.Canvas,PX+Left,PY+Top, qrOrgRes);
  86.     end;
  87.   end;
  88. end;
  89.  
  90. procedure TQrssBarcode.Notification( AComponent: TComponent; Operation: TOperation);
  91.  
  92. begin
  93.   inherited Notification(AComponent, Operation);
  94.   if (Operation=opRemove) and (AComponent=FBarcode) then
  95.     SetBarcode(nil);
  96. end;
  97.  
  98. procedure Register;
  99. begin
  100.   RegisterComponents('Soft Sector', [TQRssBarcode]);
  101. end;
  102.  
  103. end.
  104.